home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows5 / wedl20.zip / DEMOTPW.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  20KB  |  552 lines
  1.  
  2. {-----------------------------------------------------------------------------}
  3. {                                                                             }
  4. {           WEDL (tm) - Windows Enhanced Dialog Library                       }
  5. {           Copyright (c) 1991-1992, Nemisoft, Inc.                           }
  6. {           All Rights Reserved                                               }
  7. {           Module:  DEMOTPW.PAS                                              }
  8. {                                                                             }
  9. {-----------------------------------------------------------------------------}
  10.  
  11. program DemoTPW;
  12.  
  13. {$S-}
  14. {$R-}
  15. {$N+}
  16.  
  17. {$R DEMOTPW.RES}
  18.  
  19. uses WinTypes, WinProcs, WEDL;
  20.  
  21. {-----------------------------------------------------------------------------}
  22.  
  23. type
  24.     states_t = record
  25.         state_code : PStr;
  26.         zip_low    : Integer;
  27.         zip_high   : Integer;
  28.     end;
  29.  
  30. {-----------------------------------------------------------------------------}
  31.  
  32. const
  33.     ClassName       = 'WEDLDemoTPW';
  34.     idm_Dialog1     = 90;
  35.     idm_Exit        = 91;
  36.     idm_About       = 92;
  37.     idd_SSN         = 100;
  38.     idd_FirstName   = 101;
  39.     idd_MidInit     = 102;
  40.     idd_LastName    = 103;
  41.     idd_Address     = 104;
  42.     idd_City        = 105;
  43.     idd_State       = 106;
  44.     idd_ZipCode     = 107;
  45.     idd_Phone       = 108;
  46.     idd_HireDate    = 109;
  47.     idd_Wage        = 110;
  48.     idd_Insert      = 111;
  49.     idh_SSN         = 100;
  50.     idh_FirstName   = 101;
  51.     idh_MidInit     = 102;
  52.     idh_LastName    = 103;
  53.     idh_Address     = 104;
  54.     idh_City        = 105;
  55.     idh_State       = 106;
  56.     idh_ZipCode     = 107;
  57.     idh_Phone       = 108;
  58.     idh_HireDate    = 109;
  59.     idh_Wage        = 110;
  60.     BAD_STATE       = 1;
  61.     BAD_ZIP         = 2;
  62.     BAD_DATE        = 3;
  63.     states          : array[0..54] of states_t = (
  64.         ( state_code: 'AK'; zip_low: 995; zip_high: 999 ),
  65.         ( state_code: 'AL'; zip_low: 350; zip_high: 369 ),
  66.         ( state_code: 'AR'; zip_low: 716; zip_high: 729 ),
  67.         ( state_code: 'AZ'; zip_low: 850; zip_high: 865 ),
  68.         ( state_code: 'CA'; zip_low: 900; zip_high: 961 ),
  69.         ( state_code: 'CO'; zip_low: 800; zip_high: 816 ),
  70.         ( state_code: 'CT'; zip_low: 60;  zip_high: 69 ),
  71.         ( state_code: 'DE'; zip_low: 197; zip_high: 199 ),
  72.         ( state_code: 'FL'; zip_low: 320; zip_high: 349 ),
  73.         ( state_code: 'GA'; zip_low: 300; zip_high: 319 ),
  74.         ( state_code: 'HI'; zip_low: 967; zip_high: 968 ),
  75.         ( state_code: 'IA'; zip_low: 500; zip_high: 528 ),
  76.         ( state_code: 'ID'; zip_low: 832; zip_high: 847 ),
  77.         ( state_code: 'IL'; zip_low: 600; zip_high: 629 ),
  78.         ( state_code: 'IN'; zip_low: 460; zip_high: 479 ),
  79.         ( state_code: 'KS'; zip_low: 641; zip_high: 679 ),
  80.         ( state_code: 'KY'; zip_low: 400; zip_high: 427 ),
  81.         ( state_code: 'LA'; zip_low: 700; zip_high: 714 ),
  82.         ( state_code: 'MA'; zip_low: 10;  zip_high: 27 ),
  83.         ( state_code: 'MD'; zip_low: 206; zip_high: 219 ),
  84.         ( state_code: 'ME'; zip_low: 39;  zip_high: 49 ),
  85.         ( state_code: 'MI'; zip_low: 480; zip_high: 499 ),
  86.         ( state_code: 'MN'; zip_low: 550; zip_high: 567 ),
  87.         ( state_code: 'MO'; zip_low: 630; zip_high: 658 ),
  88.         ( state_code: 'MS'; zip_low: 386; zip_high: 397 ),
  89.         ( state_code: 'MT'; zip_low: 590; zip_high: 599 ),
  90.         ( state_code: 'NC'; zip_low: 270; zip_high: 289 ),
  91.         ( state_code: 'ND'; zip_low: 580; zip_high: 588 ),
  92.         ( state_code: 'NE'; zip_low: 680; zip_high: 693 ),
  93.         ( state_code: 'NH'; zip_low: 30;  zip_high: 38 ),
  94.         ( state_code: 'NJ'; zip_low: 70;  zip_high: 89 ),
  95.         ( state_code: 'NM'; zip_low: 870; zip_high: 884 ),
  96.         ( state_code: 'NV'; zip_low: 889; zip_high: 898 ),
  97.         ( state_code: 'NY'; zip_low: 100; zip_high: 149 ),
  98.         ( state_code: 'OH'; zip_low: 430; zip_high: 458 ),
  99.         ( state_code: 'OK'; zip_low: 730; zip_high: 749 ),
  100.         ( state_code: 'OR'; zip_low: 970; zip_high: 979 ),
  101.         ( state_code: 'PA'; zip_low: 150; zip_high: 196 ),
  102.         ( state_code: 'RI'; zip_low: 27;  zip_high: 29 ),
  103.         ( state_code: 'SC'; zip_low: 290; zip_high: 299 ),
  104.         ( state_code: 'SD'; zip_low: 570; zip_high: 577 ),
  105.         ( state_code: 'TN'; zip_low: 370; zip_high: 385 ),
  106.         ( state_code: 'TX'; zip_low: 750; zip_high: 885 ),
  107.         ( state_code: 'UT'; zip_low: 840; zip_high: 847 ),
  108.         ( state_code: 'VA'; zip_low: 220; zip_high: 246 ),
  109.         ( state_code: 'VT'; zip_low: 50;  zip_high: 59 ),
  110.         ( state_code: 'WA'; zip_low: 980; zip_high: 994 ),
  111.         ( state_code: 'WI'; zip_low: 530; zip_high: 549 ),
  112.         ( state_code: 'WV'; zip_low: 247; zip_high: 268 ),
  113.         ( state_code: 'WY'; zip_low: 820; zip_high: 831 ),
  114.         ( state_code: 'DC'; zip_low: 200; zip_high: 205 ),
  115.         ( state_code: 'GU'; zip_low: 0;   zip_high: 999 ),
  116.         ( state_code: 'PR'; zip_low: 0;   zip_high: 999 ),
  117.         ( state_code: 'VI'; zip_low: 0;   zip_high: 999 ),
  118.         ( state_code: nil ; zip_low: 0;   zip_high: 0   ) );
  119.  
  120. {-----------------------------------------------------------------------------}
  121.  
  122. var
  123.     Form         : hform;
  124.     perror_func  : PERRFUNC;
  125.     pcheck_state, pcheck_zip_code, pcheck_date : PVALFUNC;
  126.     tbuf : array[0..512] of Char;
  127.     soc_sec_no : LongInt;
  128.     first_name : array[0..15] of Char;
  129.     mid_init   : array[0..1]  of Char;
  130.     last_name  : array[0..20] of Char;
  131.     address    : array[0..30] of Char;
  132.     city       : array[0..15] of Char;
  133.     state      : array[0..2]  of Char;
  134.     zip_code   : array[0..9]  of Char;
  135.     phone_num  : array[0..10] of Char;
  136.     hire_date  : array[0..8]  of Char;
  137.     wage       : Double;
  138.     wage_str   : array[0..20] of Char;
  139.  
  140. {-----------------------------------------------------------------------------}
  141.  
  142. function AboutProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
  143. begin
  144.     AboutProc := True;
  145.     case Message of
  146.         wm_InitDialog:
  147.             Exit;
  148.         wm_Command:
  149.             if (WParam = id_Ok) or (WParam = id_Cancel) then
  150.             begin
  151.                 EndDialog(Dialog, 1);
  152.                 Exit;
  153.             end;
  154.     end;
  155.     AboutProc := False;
  156. end;
  157.  
  158. {-----------------------------------------------------------------------------}
  159.  
  160. function ErrorHandler( Form: HFORM; Field: HFIELD; error_value, error_position,
  161.                        error_event: Integer ): Bool; export;
  162. var
  163.     Dialog: HWnd;
  164. begin
  165.     ErrorHandler := True;
  166.     Dialog := form_get_hdlg( Form );
  167.     case error_value of
  168.         BAD_DATE:
  169.             begin
  170.                 MessageBox( Dialog, 'Date Is Invalid', nil, mb_Ok );
  171.                 Exit;
  172.             end;
  173.         BAD_STATE:
  174.             begin
  175.                 MessageBox( Dialog, 'Invalid State Code', nil, mb_Ok );
  176.                 Exit;
  177.             end;
  178.         BAD_ZIP:
  179.             begin
  180.                 if (error_position > 1) then
  181.                     MessageBox( Dialog, 'Zip Code is incomplete', nil, mb_Ok )
  182.                 else
  183.                     MessageBox( Dialog, 'Zip code is invalid for given State', nil, mb_Ok );
  184.                 Exit;
  185.             end;
  186.     end;
  187.     ErrorHandler := False;          { error was not handled }
  188. end;
  189.  
  190. {-----------------------------------------------------------------------------}
  191.  
  192. function DialogProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
  193. var
  194.     P : array[0..11] of PChar;
  195. begin
  196.     DialogProc := True;
  197.     case Message of
  198.         wm_InitDialog:
  199.             begin
  200.                 Form := form_begin( Dialog, FMF_NOSELECT or FMF_VKEYPRES or
  201.                                     FMF_VLEAVFLD or FMF_UPDATE or FMF_OVERTYPE,
  202.                                     perror_func );
  203.                 form_set_help( Form, 'demohelp.hlp', 0 );
  204.                 field_define( Form, idd_SSN, @soc_sec_no, FDT_LONG,
  205.                               '<0..7>99"-"99"-"9(4)', FDF_NOTBLANK or
  206.                               FDF_BLNKZERO or FDF_ZEROFILL or FDF_COMPLETE or
  207.                               FDF_NUMERIC, nil, 0, idh_SSN );
  208.                 field_define( Form, idd_FirstName, @first_name, FDT_STRING,
  209.                               'A(15)', FDF_PROPER, nil, 0, idh_FirstName );
  210.                 field_define( Form, idd_MidInit, @mid_init, FDT_STRING,
  211.                               'A(1)"."',  FDF_UPPER, nil, 0, idh_MidInit );
  212.                 field_define( Form, idd_LastName, @last_name, FDT_STRING,
  213.                               '<A..Z>A(19)', FDF_PROPER,
  214.                               nil, 0, idh_LastName );
  215.                 field_define( Form, idd_Address, @address, FDT_STRING,
  216.                               '?(30)', FDF_PROPER, nil, 0, idh_Address );
  217.                 field_define( Form, idd_City, @city, FDT_STRING,
  218.                               '?(15)', FDF_PROPER, nil, 0, idh_City );
  219.                 field_define( Form, idd_State, @state, FDT_STRING,
  220.                               'A(2)', FDF_COMPLETE or FDF_UPPER,
  221.                               pcheck_state, BAD_STATE, idh_State );
  222.                 field_define( Form, idd_ZipCode, @zip_code, FDT_STRING,
  223.                               '<0..9>(5)"-"9(4)', FDF_NONE,
  224.                               pcheck_zip_code, BAD_ZIP, idh_ZipCode );
  225.                 field_define( Form, idd_Phone, @phone_num, FDT_STRING,
  226.                               '"("999") "999"-"9999', FDF_COMPLETE,
  227.                               nil, 0, idh_Phone );
  228.                 field_define( Form, idd_HireDate, @hire_date, FDT_STRING,
  229.                               ' <01> 9 / <0123> 9 / <89> 9 ', FDF_COMPLETE or
  230.                               FDF_PHYSICAL, pcheck_date, BAD_DATE,
  231.                               idh_HireDate );
  232.                 field_define( Form, idd_Wage, @wage, FDT_DOUBLE,
  233.                               '999999.99', FDF_NUMERIC or FDF_BLNKZERO or
  234.                               FDF_BLNKNEZ, nil, 0, idh_Wage );
  235.                 keystat_define( Form, idd_Insert, KSM_INSERT, 'Insert: On',
  236.                                 'Insert: Off' );
  237.                 form_end( Form );
  238.                 Exit;
  239.             end;
  240.         wm_Command:
  241.             begin
  242.                 if (WParam = id_Ok) then
  243.                 begin
  244.                     form_ok( Form );
  245.                     EndDialog(Dialog, 1);
  246.                     P[0] := PChar( soc_sec_no );
  247.                     P[1] := first_name;
  248.                     P[2] := mid_init;
  249.                     P[3] := last_name;
  250.                     P[4] := address;
  251.                     P[5] := city;
  252.                     P[6] := state;
  253.                     P[7] := zip_code;
  254.                     P[8] := phone_num;
  255.                     P[9] := hire_date;
  256.                     Str( wage, wage_str );
  257.                     P[10] := wage_str;
  258.                     wvsprintf( tbuf, 'Soc Sec No.' + Chr(9) + '= %09ld' + Chr(10) +
  259.                                'Name' + Chr(9) + Chr(9) + '= %s %s. %s' + Chr(10) +
  260.                                'Address' + Chr(9) + Chr(9) + '= %s' + Chr(10) +
  261.                                Chr(9) + Chr(9) + '= %s, %s %s' + Chr(10) +
  262.                                'Phone No.' + Chr(9) + '= %s' + Chr(10) +
  263.                                'Hire Date' + Chr(9) + '= %s' + Chr(10) +
  264.                                'Wage/Salary' + Chr(9) + '= %s', P );
  265.                     MessageBox( 0, tbuf, 'Field Contents', mb_Ok );
  266.                     Exit;
  267.                 end;
  268.                 if (WParam = id_Cancel) then
  269.                 begin
  270.                     form_cancel( Form );
  271.                     EndDialog(Dialog, 1);
  272.                     Exit;
  273.                 end;
  274.             end;
  275.         wm_Close:
  276.             begin
  277.                 SendMessage( Dialog, wm_Command, id_Cancel, 0 );
  278.                 Exit;
  279.             end;
  280.     end;
  281.     DialogProc := False;
  282. end;
  283.  
  284. {-----------------------------------------------------------------------------}
  285.  
  286. Function CheckDate( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
  287. var
  288.     date : array[0..10] of Char;
  289.     month, day, year, Code: Integer;
  290. begin
  291.     CheckDate := 0;
  292.     if not str_is_blank( PBuf ) then
  293.     begin
  294.  
  295.         { parse year, day, and month from buffer }
  296.         lstrcpy( date, PBuf );
  297.         Val( date + 4, year, Code );
  298.         date[4] := Chr( 0 );
  299.         Val( date + 2, day, Code );
  300.         date[2] := Chr( 0 );
  301.         Val( date, month, Code );
  302.  
  303.         { validate month }
  304.         if month > 12 then
  305.         begin
  306.             CheckDate := 1;
  307.             Exit;
  308.         end;
  309.  
  310.         { validate day and month }
  311.         if day < 1 then
  312.         begin
  313.             CheckDate := 3;
  314.             Exit;
  315.         end;
  316.         case month of
  317.             2:
  318.                 if year mod 4 <> 0 then
  319.                 begin
  320.                     if day > 29 then
  321.                     begin
  322.                         CheckDate := 3;
  323.                         Exit;
  324.                     end;
  325.                 end
  326.                 else
  327.                 begin
  328.                     if day > 28 then
  329.                     begin
  330.                         CheckDate := 3;
  331.                         Exit;
  332.                     end;
  333.                 end;
  334.             1, 3, 5, 7, 8, 10, 12:
  335.                 if day > 31 then
  336.                 begin
  337.                     CheckDate := 3;
  338.                     Exit;
  339.                 end;
  340.             4, 6, 9, 11:
  341.                 if day > 30 then
  342.                 begin
  343.                     CheckDate := 3;
  344.                     Exit;
  345.                 end;
  346.             else
  347.                 begin
  348.                     CheckDate := 1;
  349.                     Exit;
  350.                 end;
  351.         end;
  352.     end;
  353. end;
  354.  
  355. {-----------------------------------------------------------------------------}
  356.  
  357. Function CheckState( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
  358. var
  359.     i : Integer;
  360. begin
  361.  
  362.     { allow state to be blank }
  363.     if str_is_blank( PBuf ) then
  364.     begin
  365.         CheckState := 0;
  366.         Exit;
  367.     end;
  368.  
  369.     { do for all state codes in the table }
  370.     i := 0;
  371.     while states[i].state_code <> nil do
  372.     begin
  373.         if lstrcmp( states[i].state_code, PBuf ) = 0 then
  374.         begin
  375.             CheckState := 0;
  376.             Exit;
  377.         end;
  378.         Inc( i );
  379.     end;
  380.  
  381.     { not a legal 2-letter state code }
  382.     CheckState := 1;
  383. end;
  384.  
  385. {-----------------------------------------------------------------------------}
  386.  
  387. function CheckZipCode( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
  388. var
  389.     p : PStr;
  390.     i, j, num_spaces : Integer;
  391.     zip, zip_low, zip_high : LongInt;
  392. begin
  393.  
  394.     { allow zip code to be blank }
  395.     if str_is_blank( PBuf ) then
  396.     begin
  397.         CheckZipCode := 0;
  398.         Exit;
  399.     end;
  400.  
  401.     { count spaces in the extended portion of the 9-digit zip code }
  402.     num_spaces := 0;
  403.     p := PBuf + 5;
  404.     while p^ <> Chr( 0 ) do
  405.     begin
  406.         if p^ = ' ' then Inc( num_spaces );
  407.         Inc( p );
  408.     end;
  409.  
  410.     { if zip code isn't exactly 5 or 9 digits, then there's an error }
  411.     if ( num_spaces <> 0 ) and ( num_spaces <> 4 ) then
  412.     begin
  413.         CheckZipCode := 6;
  414.         Exit;
  415.     end;
  416.  
  417.     PBuf[5] := Chr( 0 );
  418.     field_log_to_data( Field, PBuf, @zip, FDT_LONG );
  419.  
  420.     { find matching state }
  421.     Field := field_get_from_ctrl_id( Form, IDD_STATE );
  422.     field_get_text( Field, tbuf, False );
  423.     i := 0;
  424.     j := -1;
  425.     while states[i].state_code <> nil do
  426.     begin
  427.         if lstrcmp( tbuf, states[i].state_code ) = 0 then j := i;
  428.         Inc( i );
  429.     end;
  430.     if j <> -1 then i := j;
  431.     if states[i].state_code = nil then
  432.     begin
  433.         CheckZipCode := 0;
  434.         Exit;
  435.     end;
  436.  
  437.     { test zip code }
  438.     zip_low  := LongInt( states[i].zip_low )  * LongInt( 100 );
  439.     zip_high := LongInt( states[i].zip_high ) * LongInt( 100 );
  440.     if ( zip >= zip_low ) and ( zip <= zip_high ) then
  441.         CheckZipCode := 0
  442.     else
  443.         CheckZipCode := 1;
  444. end;
  445.  
  446. {-----------------------------------------------------------------------------}
  447.  
  448. function MainWndProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
  449. var
  450.     pDialogProc, pAboutProc: TFarProc;
  451. begin
  452.     MainWndProc := 0;
  453.     case Message of
  454.         wm_Command:
  455.             case WParam of
  456.                 idm_Dialog1:
  457.                     begin
  458.                         pDialogProc := MakeProcInstance(@DialogProc, HInstance);
  459.                         pcheck_date := MakeProcInstance(@CheckDate, HInstance );
  460.                         pcheck_state := MakeProcInstance(@CheckState, HInstance );
  461.                         pcheck_zip_code := MakeProcInstance(@CheckZipCode, HInstance );
  462.                         perror_func := MakeProcInstance(@ErrorHandler, HInstance);
  463.                         DialogBox(HInstance, 'DIALOG_1', Window, pDialogProc);
  464.                         FreeProcInstance(perror_func);
  465.                         FreeProcInstance(pcheck_zip_code);
  466.                         FreeProcInstance(pcheck_state);
  467.                         FreeProcInstance(pcheck_date);
  468.                         FreeProcInstance(pDialogProc);
  469.                         Exit;
  470.                     end;
  471.                 idm_Exit:
  472.                     begin
  473.                         SendMessage(Window, wm_Close, 0, 0);
  474.                         Exit;
  475.                     end;
  476.                 idm_About:
  477.                     begin
  478.                         pAboutProc := MakeProcInstance(@AboutProc, HInstance);
  479.                         DialogBox(HInstance, 'AboutWEDL', Window, pAboutProc);
  480.                         FreeProcInstance(pAboutProc);
  481.                         Exit;
  482.                     end;
  483.             end;
  484.         wm_Destroy:
  485.             begin
  486.                 PostQuitMessage(0);
  487.                 Exit;
  488.             end;
  489.     end;
  490.     MainWndProc := DefWindowProc(Window, Message, WParam, LParam);
  491. end;
  492.  
  493. {-----------------------------------------------------------------------------}
  494.  
  495. procedure InitApplication;
  496. const
  497.     WindowClass: TWndClass = (
  498.         style: 0;
  499.         lpfnWndProc: @MainWndProc;
  500.         cbClsExtra: 0;
  501.         cbWndExtra: 0;
  502.         hInstance: 0;
  503.         hIcon: 0;
  504.         hCursor: 0;
  505.         hbrBackground: 0;
  506.         lpszMenuName: 'MainMenu';
  507.         lpszClassName: ClassName
  508.     );
  509. begin
  510.     WindowClass.hInstance := HInstance;
  511.     WindowClass.hIcon := LoadIcon(0, idi_Application);
  512.     WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  513.     WindowClass.hbrBackground := GetStockObject(white_Brush);
  514.     if not RegisterClass(WindowClass) then Halt(1);
  515. end;
  516.  
  517. {-----------------------------------------------------------------------------}
  518.  
  519. procedure InitInstance;
  520. var
  521.     Window: HWnd;
  522. begin
  523.     Window := CreateWindow( ClassName, 'WEDL Demonstration Program',
  524.                             ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
  525.                             cw_UseDefault, cw_UseDefault, 0, 0, HInstance,
  526.                             nil );
  527.     if Window = 0 then Halt(1);
  528.     ShowWindow(Window, CmdShow);
  529.     UpdateWindow(Window);
  530. end;
  531.  
  532. {-----------------------------------------------------------------------------}
  533.  
  534. procedure WinMain;
  535. var
  536.     Message: TMsg;
  537. begin
  538.     if HPrevInst = 0 then InitApplication;
  539.     InitInstance;
  540.     while GetMessage(Message, 0, 0, 0) do
  541.     begin
  542.         TranslateMessage(Message);
  543.         DispatchMessage(Message);
  544.     end;
  545.     Halt(Message.wParam);
  546. end;
  547.  
  548. begin
  549.     WinMain;
  550. end.
  551.  
  552.